home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / music / dsik_pas.zip / LOAD.PAS < prev    next >
Pascal/Delphi Source File  |  1994-07-28  |  11KB  |  449 lines
  1. (*  load.pas - Digital Sound Interface Kit V1.01a loading routines.
  2.  
  3.     Copyright 1993,94 Carlos Hasan
  4. *)
  5.  
  6. unit Load;
  7.  
  8. interface
  9. uses Sound;
  10.  
  11. (* Status Value *)
  12. var
  13.   DSMStatus : word;
  14.  
  15. (* Sound System API Routines *)
  16. function DSMLoad(const FileName:String; FileOffset:dword):PDSM;
  17. procedure DSMFree(Module:PDSM);
  18. function DSMLoadSample(const FileName:String; FileOffset:dword):PDSMInst;
  19. procedure DSMFreeSample(Inst:PDSMInst);
  20. function DSMLoadSetup(var Card:DSMCard):boolean;
  21. function DSMSaveSetup(var Card:DSMCard):boolean;
  22.  
  23. implementation
  24.  
  25. (* I/O File Operations *)
  26. const
  27.   SEEK_SET = 0;
  28.   SEEK_CUR = 1;
  29.   SEEK_END = 2;
  30.  
  31. function Open(var Handle:file; const FileName:String):boolean;
  32. begin
  33.   {$I-}
  34.   System.Assign(Handle,FileName);
  35.   System.Reset(Handle,1);
  36.   {$I+}
  37.   Open := (System.IOResult <> 0);
  38. end;
  39.  
  40. function Create(var Handle:file; const FileName:String):boolean;
  41. begin
  42.   {$I-}
  43.   System.Assign(Handle,FileName);
  44.   System.Rewrite(Handle,1);
  45.   {$I+}
  46.   Create := (System.IOResult <> 0);
  47. end;
  48.  
  49. procedure Close(var Handle:file);
  50. begin
  51.   {$I-}
  52.   System.Close(Handle);
  53.   {$I+}
  54. end;
  55.  
  56. function Seek(var Handle:file; Offset:dword; Where:byte):boolean;
  57. begin
  58.   {$I-}
  59.   case Where of
  60.     SEEK_SET : System.Seek(Handle,Offset);
  61.     SEEK_CUR : System.Seek(Handle,System.FilePos(Handle)+Offset);
  62.     SEEK_END : System.Seek(Handle,System.FileSize(Handle)+Offset);
  63.   end;
  64.   {$I+}
  65.   Seek := (System.IOResult <> 0);
  66. end;
  67.  
  68. function Read(var Handle:file; var Buf; Count:word):word;
  69. var
  70.   Readed : word;
  71. begin
  72.   {$I-}
  73.   System.BlockRead(Handle,Buf,Count,Readed);
  74.   Read := Readed;
  75.   {$I+}
  76. end;
  77.  
  78. function Write(var Handle:file; var Buf; Count:word):word;
  79. var
  80.   Written : word;
  81. begin
  82.   {$I-}
  83.   System.BlockWrite(Handle,Buf,Count,Written);
  84.   Write := Written;
  85.   {$I+}
  86. end;
  87.  
  88.  
  89. function DSMLoadInst(var Handle:file):PDSMInst;
  90. var
  91.   Inst    : PDSMInst;
  92.   Samples : Pointer;
  93. begin
  94.   GetMem(Inst,sizeof(DSMInst));
  95.   if Inst = nil then begin
  96.     DSMStatus := ERR_NORAM;
  97.     DSMLoadInst := nil;
  98.     exit;
  99.   end;
  100.   if Read(Handle,Inst^,sizeof(DSMInst)) <> sizeof(DSMInst) then begin
  101.     DSMStatus := ERR_ACCESS;
  102.     FreeMem(Inst,sizeof(DSMInst));
  103.     DSMLoadInst := nil;
  104.     exit;
  105.   end;
  106.   if Inst^.Length = 0 then begin
  107.     Inst^.Address := nil;
  108.     DSMLoadInst := Inst;
  109.     exit;
  110.   end;
  111.   GetMem(Samples,Inst^.Length);
  112.   Inst^.Address := Samples;
  113.   if Samples = nil then begin
  114.     DSMStatus := ERR_NORAM;
  115.     FreeMem(Inst,sizeof(DSMInst));
  116.     DSMLoadInst := nil;
  117.     exit;
  118.   end;
  119.   if Read(Handle,Inst^.Address^,Inst^.Length) <> Inst^.Length then begin
  120.     DSMStatus := ERR_ACCESS;
  121.     FreeMem(Inst^.Address,Inst^.Length);
  122.     FreeMem(Inst,sizeof(DSMInst));
  123.     DSMLoadInst := nil;
  124.     exit;
  125.   end;
  126.   if DSMAllocSampleData(Inst) then begin
  127.     DSMStatus := ERR_NODRAM;
  128.     FreeMem(Samples,Inst^.Length);
  129.     FreeMem(Inst,sizeof(DSMInst));
  130.     DSMLoadInst := nil;
  131.     exit;
  132.   end;
  133.   if DSMTypeOfRAM = RAM_CARD then begin
  134.     FreeMem(Samples,Inst^.Length);
  135.   end;
  136.   DSMLoadInst := Inst;
  137. end;
  138.  
  139. procedure DSMFreeInst(Inst:PDSMInst);
  140. begin
  141.   if Inst <> nil then begin
  142.     if Inst^.Address <> nil then begin
  143.       DSMFreeSampleData(Inst);
  144.       if DSMTypeOfRAM <> RAM_CARD then begin
  145.         FreeMem(Inst^.Address,Inst^.Length);
  146.       end;
  147.     end;
  148.     FreeMem(Inst,sizeof(DSMInst));
  149.   end;
  150. end;
  151.  
  152. function DSMLoadPatt(var Handle:file):PDSMPatt;
  153. var
  154.   Patt   : PDSMPatt;
  155.   Length : word;
  156. begin
  157.   if Read(Handle,Length,sizeof(Length)) <> sizeof(Length) then begin
  158.     DSMStatus := ERR_ACCESS;
  159.     DSMLoadPatt := nil;
  160.     exit;
  161.   end;
  162.   GetMem(Patt,Length);
  163.   if Patt = nil then begin
  164.     DSMStatus := ERR_NORAM;
  165.     DSMLoadPatt := nil;
  166.     exit;
  167.   end;
  168.   Patt^.Length := Length;
  169.   dec(Length,sizeof(Length));
  170.   if Read(Handle,Patt^.Data,Length) <> Length then begin
  171.     DSMStatus := ERR_ACCESS;
  172.     FreeMem(Patt,Patt^.Length);
  173.     DSMLoadPatt := nil;
  174.     exit;
  175.   end;
  176.   DSMLoadPatt := Patt;
  177. end;
  178.  
  179. procedure DSMFreePatt(Patt:PDSMPatt);
  180. begin
  181.   if Patt <> nil then FreeMem(Patt,Patt^.Length);
  182. end;
  183.  
  184. function DSMLoad(const FileName:String; FileOffset:dword):PDSM;
  185. var
  186.   Handle : file;
  187.   Header : DSMHeader;
  188.   Block  : DSMBlock;
  189.   Module : PDSM;
  190.   Inst   : ^PDSMInst;
  191.   Patt   : ^PDSMPatt;
  192. begin
  193.   GetMem(Module,sizeof(DSM));
  194.   if Module = nil then begin
  195.     DSMStatus := ERR_NORAM;
  196.     DSMLoad := nil;
  197.     exit;
  198.   end;
  199.   FillChar(Module^,sizeof(DSM),0);
  200.   Inst := Addr(Module^.Inst);
  201.   Patt := Addr(Module^.Patt);
  202.  
  203.   if Open(Handle,FileName) then begin
  204.     DSMStatus := ERR_NOFILE;
  205.     DSMFree(Module);
  206.     DSMLoad := nil;
  207.     exit;
  208.   end;
  209.   if Seek(Handle,FileOffset,SEEK_SET) then begin
  210.     DSMStatus := ERR_ACCESS;
  211.     DSMFree(Module);
  212.     Close(Handle);
  213.     DSMLoad := nil;
  214.     exit;
  215.   end;
  216.   if Read(Handle,Header,sizeof(Header)) <> sizeof(Header) then begin
  217.     DSMStatus := ERR_ACCESS;
  218.     DSMFree(Module);
  219.     Close(Handle);
  220.     DSMLoad := nil;
  221.     exit;
  222.   end;
  223.   if (Header.ID <> ID_RIFF) or (Header.FileType <> ID_DSMF) then begin
  224.     DSMStatus := ERR_FORMAT;
  225.     DSMFree(Module);
  226.     Close(Handle);
  227.     DSMLoad := nil;
  228.     exit;
  229.   end;
  230.   dec(Header.Length,sizeof(Header.FileType));
  231.   while Header.Length <> 0 do begin
  232.     if Read(Handle,Block,sizeof(Block)) <> sizeof(Block) then begin
  233.       DSMStatus := ERR_ACCESS;
  234.       DSMFree(Module);
  235.       Close(Handle);
  236.       DSMLoad := nil;
  237.       exit;
  238.     end;
  239.     dec(Header.Length,sizeof(Block)+Block.Length);
  240.     if Block.ID = ID_SONG then begin
  241.       if Read(Handle,Module^.Song,Block.Length) <> Block.Length then begin
  242.         DSMStatus := ERR_ACCESS;
  243.         DSMFree(Module);
  244.         Close(Handle);
  245.         DSMLoad := nil;
  246.         exit;
  247.       end;
  248.     end
  249.     else if Block.ID = ID_INST then begin
  250.       Inst^ := DSMLoadInst(Handle);
  251.       if Inst^ = nil then begin
  252.         DSMFree(Module);
  253.         Close(Handle);
  254.         DSMLoad := nil;
  255.         exit;
  256.       end;
  257.       inc(Inst);
  258.     end
  259.     else if Block.ID = ID_PATT then begin
  260.       Patt^ := DSMLoadPatt(Handle);
  261.       if Patt^ = nil then begin
  262.         DSMFree(Module);
  263.         Close(Handle);
  264.         DSMLoad := nil;
  265.         exit;
  266.       end;
  267.       inc(Patt);
  268.     end
  269.     else begin
  270.       if Seek(Handle,Block.Length,SEEK_CUR) then begin
  271.         DSMStatus := ERR_ACCESS;
  272.         DSMFree(Module);
  273.         Close(Handle);
  274.         DSMLoad := nil;
  275.         exit;
  276.       end;
  277.     end;
  278.   end;
  279.   Close(Handle);
  280.   DSMLoad := Module;
  281. end;
  282.  
  283. procedure DSMFree(Module:PDSM);
  284. var
  285.   I    : word;
  286.   Inst : ^PDSMInst;
  287.   Patt : ^PDSMPatt;
  288. begin
  289.   if Module <> nil then begin
  290.     Inst := Addr(Module^.Inst);
  291.     for I := 0 to Pred(MAXSAMPLES) do begin
  292.       if Inst^ <> nil then DSMFreeInst(Inst^);
  293.       inc(Inst);
  294.     end;
  295.     Patt := Addr(Module^.Patt);
  296.     for I := 0 to pred(MAXORDERS) do begin
  297.       if Patt^ <> nil then DSMFreePatt(Patt^);
  298.       inc(Patt);
  299.     end;
  300.     FreeMem(Module,sizeof(DSM));
  301.   end;
  302. end;
  303.  
  304. function DSMLoadSample(const FileName:String; FileOffset:dword):PDSMInst;
  305. var
  306.   Handle  : file;
  307.   Inst    : PDSMInst;
  308.   Samples : Pointer;
  309.   Wave    : record
  310.               Header : DSMHeader;
  311.               Format : DSMBlock;
  312.               Fmt    : DSMWave;
  313.               Data   : DSMBlock;
  314.             end;
  315. begin
  316.   GetMem(Inst,sizeof(DSMInst));
  317.   if Inst = nil then begin
  318.     DSMStatus := ERR_NORAM;
  319.     DSMLoadSample := nil;
  320.     exit;
  321.   end;
  322.   FillChar(Inst^,sizeof(DSMInst),0);
  323.   if Open(Handle,FileName) then begin
  324.     DSMStatus := ERR_NOFILE;
  325.     FreeMem(Inst,sizeof(DSMInst));
  326.     DSMLoadSample := nil;
  327.     exit;
  328.   end;
  329.   if Seek(Handle,FileOffset,SEEK_SET) then begin
  330.     DSMStatus := ERR_ACCESS;
  331.     FreeMem(Inst,sizeof(DSMInst));
  332.     Close(Handle);
  333.     DSMLoadSample := nil;
  334.     exit;
  335.   end;
  336.   if Read(Handle,Wave,sizeof(Wave)) <> sizeof(Wave) then begin
  337.     DSMStatus := ERR_ACCESS;
  338.     FreeMem(Inst,sizeof(DSMInst));
  339.     Close(Handle);
  340.     DSMLoadSample := nil;
  341.     exit;
  342.   end;
  343.   if (Wave.Header.ID <> ID_RIFF) or (Wave.Header.FileType <> ID_WAVE) or
  344.      (Wave.Format.ID <> ID_FMT) or (Wave.Data.ID <> ID_DATA) or
  345.      (Wave.Fmt.SampleFormat <> 1) or (Wave.Fmt.NumChannels <> 1) or
  346.      (Wave.Fmt.BitsPerSmpl <> 8) then begin
  347.     DSMStatus := ERR_FORMAT;
  348.     FreeMem(Inst,sizeof(DSMInst));
  349.     Close(Handle);
  350.     DSMLoadSample := nil;
  351.     exit;
  352.   end;
  353.   Inst^.Period := (dword(MIDCFREQ)*MIDCPERIOD) div Wave.Fmt.PlayRate;
  354.   Inst^.Length := Wave.Data.Length;
  355.   Inst^.MidCRate := Wave.Fmt.PlayRate;
  356.   Inst^.Volume := 64;
  357.   GetMem(Samples,Inst^.Length);
  358.   Inst^.Address := Samples;
  359.   if Samples = nil then begin
  360.     DSMStatus := ERR_NORAM;
  361.     FreeMem(Inst,sizeof(DSMInst));
  362.     Close(Handle);
  363.     DSMLoadSample := nil;
  364.     exit;
  365.   end;
  366.   if Read(Handle,Inst^.Address^,Inst^.Length) <> Inst^.Length then begin
  367.     DSMStatus := ERR_ACCESS;
  368.     FreeMem(Inst^.Address,Inst^.Length);
  369.     FreeMem(Inst,sizeof(DSMInst));
  370.     Close(Handle);
  371.     DSMLoadSample := nil;
  372.     exit;
  373.   end;
  374.   if DSMAllocSampleData(Inst) then begin
  375.     DSMStatus := ERR_NODRAM;
  376.     FreeMem(Inst^.Address,Inst^.Length);
  377.     FreeMem(Inst,sizeof(DSMInst));
  378.     Close(Handle);
  379.     DSMLoadSample := nil;
  380.     exit;
  381.   end;
  382.   if DSMTypeOfRAM = RAM_CARD then begin
  383.     FreeMem(Samples,Inst^.Length);
  384.   end;
  385.   Close(Handle);
  386.   DSMLoadSample := Inst;
  387. end;
  388.  
  389. procedure DSMFreeSample(Inst:PDSMInst);
  390. begin
  391.   if Inst <> nil then begin
  392.     if Inst^.Address <> nil then begin
  393.       DSMFreeSampleData(Inst);
  394.       if DSMTypeOfRAM <> RAM_CARD then begin
  395.         FreeMem(Inst^.Address,Inst^.Length);
  396.       end;
  397.     end;
  398.     FreeMem(Inst,sizeof(DSMInst));
  399.   end;
  400. end;
  401.  
  402. function DSMLoadSetup(var Card:DSMCard):boolean;
  403. var
  404.   Handle : file;
  405. begin
  406.   if Open(Handle,'SOUND.CFG') then begin
  407.     DSMLoadSetup := true;
  408.     exit;
  409.   end;
  410.   if Read(Handle,Card,sizeof(DSMCard)) <> sizeof(DSMCard) then begin
  411.     Close(Handle);
  412.     DSMLoadSetup := true;
  413.     exit;
  414.   end;
  415.   Close(Handle);
  416.   DSMLoadSetup := false;
  417. end;
  418.  
  419. function DSMSaveSetup(var Card:DSMCard):boolean;
  420. var
  421.   Handle : file;
  422. begin
  423.   if Create(Handle,'SOUND.CFG') then begin
  424.     DSMSaveSetup := true;
  425.     exit;
  426.   end;
  427.   if Write(Handle,Card,sizeof(DSMCard)) <> sizeof(DSMCard) then begin
  428.     Close(Handle);
  429.     DSMSaveSetup := true;
  430.     exit;
  431.   end;
  432.   Close(Handle);
  433.   DSMSaveSetup := false;
  434. end;
  435.  
  436.  
  437. function HeapFunc(Size:Word): Integer; far;
  438. begin
  439.   if Size<>0 then HeapFunc := 1;
  440. end;
  441.  
  442. begin
  443.   if Test8086 < 2 then begin
  444.     writeln('This program requires at least an 80386 processor.');
  445.     halt;
  446.   end;
  447.   HeapError := @HeapFunc;
  448. end.
  449.